home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / tool_inc.zip / DISKSPAC.INC < prev    next >
Text File  |  1990-01-23  |  1KB  |  47 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13.  
  14. function disk_space(disk: char): longint;
  15.    {report space on drive in k bytes}
  16.    {should work even wth partitions over 32meg}
  17.    {dos.diskfree fails on large partitions as of tp5.0}
  18.  
  19. var
  20.    reg:     registers;
  21.    space:   longint;
  22.    bpcl:    longint;
  23.  
  24. begin
  25.    reg.ah := $36;
  26.    if disk = '\' then
  27.       reg.dl := 0
  28.    else
  29.       reg.dl := ord(upcase(disk))-ord('@');
  30.    msdos(reg);
  31.  
  32.    if reg.ax = $FFFF then
  33.       space := 0
  34.    else
  35.    begin
  36.       {ax=sectors per cluster, bx=free clusters, cx=bytes per sector}
  37.       space := reg.bx;                 {clusters}
  38.       bpcl := reg.ax * reg.cx;         {bytes per cluster}
  39.       space := (space * bpcl) shr 10;
  40.    end;
  41.  
  42. {writeln('disk=',disk,' space=',space,' ax=',reg.ax,' bx=',reg.bx,' cx=',reg.cx);}
  43.  
  44.    disk_space := space;
  45. end;
  46.  
  47.